home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AOL File Library: 4,701 to 4,800
/
aol-file-protocol-4400-4701-to-4800.zip
/
AOLDLs
/
Autocad Utilities
/
LISP_ Bearing Distance Extractor
/
Bd.lsp
next >
Wrap
Lisp/Scheme
|
2014-12-11
|
3KB
|
82 lines
;;;
;;; BD.LSP Copyright 2002 Leo Estember All Rights Reserved.
;;;
;;; BD.LSP is a utility for use with AutoCAD Release 14 and up,
;;; which extracts the endpoints of a line and calculates the
;;; bearing angle and distance. The format for the bearing angle
;;; is degree/minutes/seconds and the distance is in drawing units.
;;; The data is shown on the screen via an alert box. After exiting
;;; the alert box, the program prompts the user to pick another line.
;;; The program continuously cycle through until the user cancels
;;; the command or hit the ENTER key.
;;;
;;; This program is provided "as is" without express or implied
;;; warrenty. All implied warranties of fitness for any particular
;;; purpose and of merchantability are hereby disclaimed. All damages
;;; arising from the use of or inability to use this software is the
;;; sole responsibility of the user. This program is "freely distributed".
;;; Distribution of this freely distributed program is granted subject
;;; to the following conditions:
;;;
;;; The reproduction and distribution of this software in its unaltered
;;; form (as downloaded) is hereby granted to all Autocad end users,
;;; Provided such reproduction and distribution is for non-commercial
;;; use and not for profit. Distribution, repackaging or reselling of
;;; this software and accompanying documentation for profit is not allowed
;;; without the written authorization of the author.
;;;
;;; Good luck.
;;;
;;; L Estember
(defun rtd (x) (* x (/ 180.0 pi)))
(defun getbearing (ang / bang sdeg smin ssec str)
(cond
((<= 0.0 ang 90.0) (setq bang (- 90.0 ang) str1 "N" str2 "E"))
((< 90.0 ang 180.0) (setq bang (- ang 90.0) str1 "N" str2 "W"))
((= ang 180.0) (setq bang 90.0 str1 "N" str2 "W"))
((< 180.0 ang 270.0) (setq bang (- 270.0 ang) str1 "S" str2 "W"))
((<= 270.0 ang 360.0) (setq bang (- ang 270.0) str1 "S" str2 "E"))
);cond
(setq str (read (rtos bang 2 8))
sdeg (fix str)
smin (* (- str sdeg) 60)
ssec (fix (* (- smin (fix smin)) 60))
bstr (strcat str1 " " (itoa sdeg) (chr 176) " " (itoa (fix smin)) "'"
" " (itoa ssec) "\"" " " str2)
)
bstr
)
(defun C:BD ( / ang bdist ed ent pt1 pt2 str)
(while (setq ent (car (entsel "\nSelect line to get bearing/distance: ")))
(if (and ent (= (cdr (assoc 0 (setq ed (entget ent)))) "LINE"))
(progn
(setq ed (entget ent)
pt1 (cdr (assoc 10 ed))
pt2 (cdr (assoc 11 ed))
ang (rtd (angle pt1 pt2))
bdist (distance pt1 pt2)
);setq
(setq str (strcat (getbearing ang) "\t" (rtos bdist 2 6)))
(Alert str)
)
)
)
(princ)
)
(princ)
(Alert (strcat "BD.LSP" "\tLINE BEARING/DISTANCE EXTRACTOR Version 1.0\n"
"\tCOPYRIGHT (C) 2002 Leo Estember, All Rights Reserved\n"
"\nThis freeware program extracts the endpoints of a line\n"
"and calculates the corresponding bearing and distance. An\n"
"alert box shows the results on screen.\n"
"\nAny interests, comments or suggestions can be forwarded\n"
"to the author at this e-mail address: grevark@aol.com \n"
"\n\t. . . . .Type BD to re-run program. . . . . .\n"
)
)
(C:BD)
(princ)